theme <- theme(text = element_text(size=10),
               plot.title = element_text(size = 12, face = "bold.italic", hjust = 0.5), 
               axis.title.x = element_text(size = 10, face="bold", colour='black'),         
               axis.title.y = element_text(size = 10, face="bold"),
               panel.border = element_blank(),
               panel.grid.major = element_blank(),
               panel.grid.minor = element_blank(), 
               legend.title = element_text(face="bold"))

Trabajo Práctico N° 2

0- Preparación del ambiente de trabajo

El trabajo práctico comenzó con la generación de una muestra aleatoria estratificada y balanceada por variedad de vino de tamaño n = 2000, utilizando como semilla los últimos tres dígitos de mi DNI (907). Para realizar el estratificado, se utilizo el comando group_by por variedad y luego con sample_n se seleccionaron 1000 datos de cada variedad, por lo que al tener 2 variedades (blanco y tinto), se obtuvo un total de 2000 datos.

Importación de los datos

Datos TP2

url_datos <- 'https://docs.google.com/spreadsheets/d/1Lt1xbq4Z3zrNpYhpXcxYauTp6vwd5pPMUCvXF1rYdSU'
datosTP1 = read.csv(text=gsheet2text(url_datos, format='csv'))
df_DatosTP1 = data.frame(datosTP1)

Muestra aleatoria estratificada y balanceada

# Seteo la semilla con los últimos 3 dígitos de mi documento
set.seed(907)

stratified_df = df_DatosTP1 %>%
  group_by(variedad) %>%
  sample_n(1000, replace=FALSE) %>%
  mutate_at('variedad', as.factor)

1- Análisis de Componentes Principales

Aplique el Análisis de Componentes Principales a la base de datos. Presente los resultados y gráficos que considere adecuados. Interprete los resultados.

Primero realizaremos un rápido análisis exploratorio de la relación y distribución de las variables, con el siguiente gráfico y luego veremos la matriz de correlación para tratar de encontrar alguna relación previa a realizar el amálisis de componentes principales.

# Genero un data frame con las variables numéricas
numeric_df = stratified_df %>% dplyr::select(where(is.numeric))
numeric_df = numeric_df[, ! names(numeric_df) %in% c("variedad"), drop = F]
gpairs_lower <- function(g){
  g$plots <- g$plots[-(1:g$nrow)]
  g$yAxisLabels <- g$yAxisLabels[-1]
  g$nrow <- g$nrow -1

  g$plots <- g$plots[-(seq(g$ncol, length(g$plots), by = g$ncol))]
  g$xAxisLabels <- g$xAxisLabels[-g$ncol]
  g$ncol <- g$ncol - 1

  g
}

g <- ggpairs(numeric_df, 
            aes(color = stratified_df$variedad, alpha = 0.5),
            lower = list(continuous = "points", combo = "dot"), 
            upper  = list(continuous = "blank"), legend = 1)+ theme(legend.position = "bottom")

# Trato de ver como se relacionan las variables
gpairs_lower(g)

Matriz de correlación

Viendo la matriz de correlación se detectan algunas relaciones fuertes entre anhidrido_sulfuroso_libre y anhidrido_sulfuroso_total, densidad y acidez_fija, una relación inversa entre alcohol y densidad y en menor medida en el resto, pero no se observa que alguna de las variables resulte ser una combinación de otras y repetir valores.

#Matriz de correlación
m_cor <- cor(numeric_df) 

# representa la matriz de correlaciones mediante círculos
corrplot(m_cor,method="circle")

Obtengo las componentes principales del DF, estandarizando las variables para evitar conflictos con diferentes unidades o medidas.

pca <- prcomp(numeric_df, scale = TRUE)
names(pca)
## [1] "sdev"     "rotation" "center"   "scale"    "x"
pca
## Standard deviations (1, .., p=12):
##  [1] 1.8331193 1.5705339 1.3784363 0.9964130 0.9025306 0.7673952 0.7082666
##  [8] 0.6896641 0.6490437 0.5134009 0.4221313 0.1907966
## 
## Rotation (n x k) = (12 x 12):
##                                  PC1         PC2         PC3         PC4
## acidez_fija                0.2855763 -0.31066701  0.36627793  0.21496097
## acidez_volatil             0.3791259  0.04944538 -0.32044794  0.02955426
## acido_citrico             -0.1023073 -0.29532391  0.50792094  0.08157573
## azucar_residual           -0.2983964 -0.34696934 -0.14452831 -0.20438937
## cloruros                   0.3147039 -0.21010308  0.01094607 -0.25283459
## anhidrido_sulfuroso_libre -0.4129819 -0.13175377 -0.11573874 -0.30497494
## anhidrido_sulfuroso_total -0.4546188 -0.17380756 -0.12223188 -0.12787815
## densidad                   0.2348569 -0.49156243 -0.12459002 -0.19414070
## pH                         0.1857383  0.32665083 -0.27451163 -0.43506936
## sulfatos                   0.2961406 -0.09415381  0.24809870 -0.55982825
## alcohol                   -0.0437656  0.45005435  0.35871288 -0.03062427
## calidad                   -0.1402157  0.20488424  0.41799327 -0.43575150
##                                   PC5          PC6         PC7         PC8
## acidez_fija               -0.22305359 -0.036361060 -0.32237748 -0.01816965
## acidez_volatil            -0.08439144  0.390166065 -0.48724659  0.21453565
## acido_citrico              0.11884084 -0.317628007  0.06032442  0.49459182
## azucar_residual           -0.41203250  0.265217879  0.08817744  0.25445039
## cloruros                   0.57221041  0.418749811  0.33884853  0.32134490
## anhidrido_sulfuroso_libre  0.21106790  0.001063509 -0.43981166  0.02909612
## anhidrido_sulfuroso_total  0.20669554 -0.033362277 -0.22340424  0.03840326
## densidad                  -0.38831169 -0.083224187  0.01030114  0.05663890
## pH                        -0.17849941 -0.518323375  0.11805254  0.39540712
## sulfatos                   0.20009685 -0.199888708 -0.29548443 -0.38973359
## alcohol                   -0.07293410  0.177072938 -0.36254385  0.43749844
## calidad                   -0.34136149  0.389690848  0.23726681 -0.18932088
##                                   PC9       PC10        PC11          PC12
## acidez_fija               -0.32887678  0.2814291 -0.33785981 -0.4297912120
## acidez_volatil            -0.10198008 -0.5077158  0.18392440 -0.0739502956
## acido_citrico             -0.02320443 -0.4165032  0.31652361  0.0143999311
## azucar_residual            0.48455303  0.1010917  0.05799249 -0.4085371122
## cloruros                  -0.08945916  0.1992747 -0.15061619 -0.0389535796
## anhidrido_sulfuroso_libre -0.39497470  0.3659256  0.42064644 -0.0001334699
## anhidrido_sulfuroso_total -0.05884927 -0.3688011 -0.70139868  0.0718420969
## densidad                  -0.08010967  0.1035912 -0.06163588  0.6841208314
## pH                        -0.20854314  0.0297492 -0.14111069 -0.2430363777
## sulfatos                   0.43482434 -0.1049630  0.04131541 -0.0864939351
## alcohol                    0.29506809  0.2940611 -0.17732959  0.3184695517
## calidad                   -0.39063240 -0.2461632  0.00441681  0.0054957050

Con los loadings de PCA (rotation) veamos cómo están relacionadas las variables y las nuevas componentes.

contrib <- as.matrix(round(pca$rotation,2))
corrplot(contrib,is.corr=FALSE)

Obtenemos los autovalores y con ellos la proporción de la variabilidad total acumulada, que nos sirva para tomar una decisión sobre la cantidad de componentes a utilizar. Eso lo decidiremos a continuación.

prop_varianza <- pca$sdev^2 / sum(pca$sdev^2)
prop_varianza_acum <- cumsum(prop_varianza)
round(prop_varianza_acum*100,2)
##  [1]  28.00  48.56  64.39  72.67  79.45  84.36  88.54  92.50  96.02  98.21
## [11]  99.70 100.00

Selección de componentes

Criterio 1: Porcentaje de variabilidad explicada

Se define un porcentaje de variabilidad mínimo que se desea explicar y se toman las primeras m componentes que alcanzan este porcentaje de explicación.

Criterio 2: Criterio de Kaiser

Consiste en retener las m primeras componentes tales que sus autovalores resulten iguales o mayores que 1.

Criterio 3: Criterio del bastón roto

Si la proporción de variabilidad explicada por \(Y1, Y2, · · ·, Ym\) se estabiliza a partir de un cierto valor de CP, entonces aumentar la dimensión no aportaría cambios significativos.

criterio1_plot = ggplot(data = data.frame(prop_varianza_acum, pc = 1:12),
       aes(x = pc, y = prop_varianza_acum, group = 1)) +
  geom_point() +
  geom_line() +
  theme_bw() +
  labs(x = "Componente principal",
       y = "Varianza explicada acumulada",
       title = "Criterio 1")

var_explained_df <- data.frame(PC=sprintf("%02d", c(1:12)),
                               var_explained=pca$sdev^2)

criterio2_plot = var_explained_df %>%
  ggplot(aes(x=PC,y=var_explained, group=1))+
  geom_point(size=2)+
  geom_hline(yintercept=1, linetype="dashed", color = "red")+
  geom_line()+
  labs(x = "Componente principal",
       y = "Varianza explicada",
       title = "Criterio 2")

criterio3_plot = fviz_eig(pca, ncp =12, addlabels = TRUE, main="Criterio 3")

combined_plot <- ggarrange(criterio1_plot,
                           criterio2_plot,
                           criterio3_plot,
                           nrow = 2,
                           ncol = 2)

combined_plot

Con los valores y los gráficos obtenidos, vemos que con los 3 criterios podemos tomar la desición de utilizar hasta la cuarta componente, donde tenemos un 73% de varianza explicada acumulada, las varianzas son mayor a 1 y en el gráfico de sedimentación vemos que la pendiente ya no es significativa y cada vez es mejor la acumulación de varianza explicada.

Conclusiones

Se realizó el biplot sobre las 4 primeras componentes, observando que en el primer caso, al colorear por variedad de vino, se percibe una clara separación entre las variedades, donde podemos apreciar cuales son las variables que más representan al vino tinto y cuales al vino blanco. Por ejemplo, el vino tinto tiene como característica principal la acidez_volatil, en cambio el vino blanco está más representado por los anhídrido.sulfuroso libre y total, quienes tienen una gran correlación entre ellos y vemos que el alcohol parece ser independiente a estas características, ya que su vector tiende a un ángulo de 90ª en relación a estas variables.

autoplot(pca, 
         data = stratified_df, 
         colour = 'variedad',
         loadings = TRUE, 
         loadings.colour = 'black',
         loadings.label = TRUE, 
         loadings.label.size = 4,
         loadings.label.color = 'black')

Viendo el resultado del biplot de las componentes 3 y 4, ya no se observa una clara diferencia entre las variedades, lo cuál tiene sentido, siendo que la varianza que explican es mucho menor a las PC1 y PC2. Lo que se observa en estas dimensiones es una gran correlación con el pH. También se observa una concentración de los scores alrededor de los loadinds de Anhídrido sulfuroso, azúcares, acidez, que son las variables que le dan las carácteristicas a los vinos, por lo que podemos pensar que en estas componentes pueden estar representando la calidad de los vinos.

autoplot(pca, 
         x = 3,
         y = 4,
         data = stratified_df, 
         colour = 'variedad',
         loadings = TRUE, 
         loadings.colour = 'black',
         loadings.label = TRUE, 
         loadings.label.size = 4,
         loadings.label.color = 'black')

2- Análisis Discriminante

Realice el Análisis Discriminante para clasificar los vinos según la variable variedad de vino. Interprete los resultados.

Preparación del espacio de trabajo

Lo primero que haremos es preparar el espacio de trabajo para poder definir las hipótesis y evaluar los resultados.

Definición del dataset de training y test

set.seed(907)

df_split <- initial_split(stratified_df,
                          prop = 0.9, # defino un proporción de 90% para training y 10% para test
                          strata = variedad)

df_train <- df_split %>%
              training()

df_test <- df_split %>%
              testing()

# Número de datos en test y train
paste0("Total del dataset de entrenamiento: ", nrow(df_train))
## [1] "Total del dataset de entrenamiento: 1800"
paste0("Total del dataset de testeo: ", nrow(df_test))
## [1] "Total del dataset de testeo: 200"

Creamos dos subsets de datos, uno para cada variedad, que es nuestra variable target.

variedad_tinto <- subset(df_train, df_train$variedad == 1)
variedad_tinto = variedad_tinto[, ! names(variedad_tinto) %in% c("variedad"), drop = F]

variedad_blanco <- subset(df_train, df_train$variedad == 2)
variedad_blanco = variedad_blanco[, ! names(variedad_blanco) %in% c("variedad"), drop = F]

Análisis de supuestos

Este tipo de análisis es válido solo si se satisfacen los siguientes supuestos:

  1. Normalidad multivariada
  2. Independencia de las observaciones
  3. Homocedasticidad.

Normalidad multivariada

Utilizamos el test de Shapiro (multivariado) para evaluar el supuesto de normalidad.

Observando los resultados, vemos que no se cumple el supuesto en ninguno de las variedades.

mvShapiro.Test(as.matrix(variedad_tinto))
## 
##  Generalized Shapiro-Wilk test for Multivariate Normality by
##  Villasenor-Alva and Gonzalez-Estrada
## 
## data:  as.matrix(variedad_tinto)
## MVW = 0.92113, p-value < 2.2e-16
mvShapiro.Test(as.matrix(variedad_blanco))  
## 
##  Generalized Shapiro-Wilk test for Multivariate Normality by
##  Villasenor-Alva and Gonzalez-Estrada
## 
## data:  as.matrix(variedad_blanco)
## MVW = 0.88823, p-value < 2.2e-16

Independencia de las observaciones

Asumimos que viene dado por el diseño del dataset.

  1. Homocedasticidad.

Realizamos el test de Box sobre el dataset de entrenamiento, indicando el subconjunto de variables y la variable target como parámetros de la función del estadístico.

Observando el resultado, vemos que no se cumple el supuesto.

boxM(cbind(acidez_fija, acidez_volatil, acido_citrico, azucar_residual, cloruros, anhidrido_sulfuroso_libre, anhidrido_sulfuroso_total, densidad, pH, sulfatos, alcohol, calidad) ~ variedad, data=df_train)
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  Y
## Chi-Sq (approx.) = 3344.8, df = 78, p-value < 2.2e-16

Como boxM es sensible a la falta de normalidad, aplico Levene utilizando betadisper del paquete “vegan” (equivalente a levene, pero multivariado)

matriz_de_distancias <- vegan::betadisper(dist(df_train[,1:12], method='euclidean'), df_train$variedad, type = c("median","centroid"), bias.adjust = T,sqrt.dist = FALSE, add = FALSE)
test_levene <- anova(matriz_de_distancias)
p.valor <- test_levene$`Pr(>F)`[1]
TukeyHSD(matriz_de_distancias)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = distances ~ group, data = df)
## 
## $group
##          diff       lwr       upr p adj
## 2-1 -12.76683 -14.92777 -10.60589     0
paste0("Levene: p-value: ", p.valor)
## [1] "Levene: p-value: 5.39896163087824e-30"

Con estos resultados no podemos avanzar con el LDA, o por lo menos, no podemos confiar en que el resultado que arroje sea válido.

Al no cumplirse el supuesto de homocedasticidad podríamos intentar recurrir al análisis discriminante cuadrático (QDA), pero en este caso tampoco se cumple el supuesto de normalidad multivariado, por lo que en ninguno de los casos podemos asegurar que los resultados sean válidos. Sin embargo, nos interesa ver cómo clasifican estos métodos, por lo que realizaremos el análisos lineal y cuadrático y compararemos los resultados.

Análisis de diferencias de medias

Además de los supuestos para aplicar el estadístico, veremos si tiene sentido realizar una clasificación al evaluar si las medias de cada categoría son diferentes, por lo que utilizaremos el test de medias multivariado para saber si la H0 de que las medias de cada grupo son iguales.

Hotelling

# Analizo cómo me da Hotelling para ver diferencias en el vector de medias de cada grupo
HOTELLING <- HotellingsT2Test(as.matrix(df_train[,1:12]) ~ variedad, data = df_train)
HOTELLING
## 
##  Hotelling's two sample T2-test
## 
## data:  as.matrix(df_train[, 1:12]) by variedad
## T.2 = 1122.6, df1 = 12, df2 = 1787, p-value < 2.2e-16
## alternative hypothesis: true location difference is not equal to c(0,0,0,0,0,0,0,0,0,0,0,0)

Al realizar el test vemos que se rechaza H0, pero al no cumplir con el supuesto de normalidad este valor podría verse afectado, por lo que realizaremos un test no parámetrico para comprobar si se obtiene el mismo resultado y se rechaza H0.

Test no paramétrico

# se utiliza el paquete npmv no paramétrico para comparar vector de medias. (Nonparametric Inference for Multivariate Data: R Package npmv, January 2017, Volume 76, Issue 4. doi: 10.18637/jss.v076.i04, https://www.jstatsoft.org/article/view/v076i04)

noparam <- nonpartest(cbind(acidez_fija, acidez_volatil, acido_citrico, azucar_residual, cloruros, anhidrido_sulfuroso_libre, anhidrido_sulfuroso_total, densidad, pH, sulfatos, alcohol, calidad) ~ variedad, data = df_train, permreps = 1000, plots=F)
noparam$results

Con los resultados del test no paramétrico podemos rechazar con confianza la H0 de que las medias de los grupos son iguales y entonces tiene sentido realizar la clasificación con los diferentes métodos, ya que tenemos 2 grupos diferentes que pueden ser clasificables.

Discriminante Lineal (LDA)

model_lda <- lda(variedad ~ ., data = df_train)
model_lda
## Call:
## lda(variedad ~ ., data = df_train)
## 
## Prior probabilities of groups:
##   1   2 
## 0.5 0.5 
## 
## Group means:
##   acidez_fija acidez_volatil acido_citrico azucar_residual   cloruros
## 1    6.833667      0.2842611     0.3323667        6.580389 0.04757000
## 2    8.283889      0.5330111     0.2672000        2.573000 0.08814333
##   anhidrido_sulfuroso_libre anhidrido_sulfuroso_total  densidad       pH
## 1                  35.52444                 138.93556 0.9940967 3.187878
## 2                  15.61778                  45.54056 0.9967803 3.316444
##    sulfatos  alcohol  calidad
## 1 0.4910778 10.50602 5.871111
## 2 0.6579444 10.39465 5.615556
## 
## Coefficients of linear discriminants:
##                                    LD1
## acidez_fija                -0.38899605
## acidez_volatil              2.35419089
## acido_citrico              -0.49248823
## azucar_residual            -0.34481045
## cloruros                    2.49345443
## anhidrido_sulfuroso_libre   0.01947955
## anhidrido_sulfuroso_total  -0.02132707
## densidad                  876.83927257
## pH                         -0.69022949
## sulfatos                    1.04827706
## alcohol                     0.71138892
## calidad                     0.04894154

Distribución de las predicciones

Al tener una única dimensión, LD1, generamos un histograma para observa la distribución de las predicciones y si existe solapamiente y en qué medida. Esto lo confirmaremos luego con la matriz de confusión.

p <- predict(model_lda, df_train)
ldahist(data = p$x[,1], g = df_train$variedad)

Matriz de confusión

Vemos que los resultados obtenidos en training son buenos debido a que tenemos un accuracy del 99%

p1 <- predict(model_lda, df_train)$class
confusion_train = table(Predicted = p1, Actual = df_train$variedad)
confusion_train
##          Actual
## Predicted   1   2
##         1 896   8
##         2   4 892
# Accuracy
sum(diag(confusion_train))/sum(confusion_train)
## [1] 0.9933333

Veamos los resultados con el subset de test. Vemos que las predicciones fueron excelente.

p2 <- predict(model_lda, df_test)$class
confusion_test = table(Predicted = p2, Actual = df_test$variedad)
confusion_test
##          Actual
## Predicted   1   2
##         1 100   0
##         2   0 100
# Accuracy
sum(diag(confusion_test))/sum(confusion_test)
## [1] 1

Conclusión

Aunque no se hayan cumplidos los supuestos de normalidad multivariada y homocedasticidad, vemos que el LDA clasificó con un 99% de accuracy el dataset de entrenamiento. Si bien no podemos confiar en que el LDA sea confiable al no cumplir con los supuestos, en la práctiva vemos que los resultados empíricos brindan un grado aceptable de confianza. Sería necesario realizar más pruebas con otro dataset para corroborarlo, pero es un modelo que se puede utilizar.

Discriminante Cuadrático (QDA)

Ahora realizaremos el análisis discriminante cuadrático para comparar los resultados. Siempre teniendo en cuanta que no se cumplen los supuestos necesarios, en este caso el de normalidad multivariada.

model_qda <- qda(variedad ~ ., df_train)
model_qda
## Call:
## qda(variedad ~ ., data = df_train)
## 
## Prior probabilities of groups:
##   1   2 
## 0.5 0.5 
## 
## Group means:
##   acidez_fija acidez_volatil acido_citrico azucar_residual   cloruros
## 1    6.833667      0.2842611     0.3323667        6.580389 0.04757000
## 2    8.283889      0.5330111     0.2672000        2.573000 0.08814333
##   anhidrido_sulfuroso_libre anhidrido_sulfuroso_total  densidad       pH
## 1                  35.52444                 138.93556 0.9940967 3.187878
## 2                  15.61778                  45.54056 0.9967803 3.316444
##    sulfatos  alcohol  calidad
## 1 0.4910778 10.50602 5.871111
## 2 0.6579444 10.39465 5.615556

Dataset de entrenamiento

p3 <- predict(model_qda, df_train)$class
confusion_q_train = table(Predicted = p3, Actual = df_train$variedad)
confusion_q_train
##          Actual
## Predicted   1   2
##         1 885   7
##         2  15 893
# Accuracy
sum(diag(confusion_q_train))/sum(confusion_q_train)
## [1] 0.9877778

Dataset de prueba

p4 <- predict(model_qda, df_test)$class
confusion_q_test = table(Predicted = p4, Actual = df_test$variedad)
confusion_q_test
##          Actual
## Predicted   1   2
##         1 100   0
##         2   0 100
# Accuracy
sum(diag(confusion_q_test))/sum(confusion_q_test)
## [1] 1

Conclusión

Comparando los resultados con los obtenidos con LDA, vemos que el accuracy de QDA es menor, lo cual puede ser por la presencia de outliers, donde QDA es más sensible o puede ser que la falta de normalidad esté afectando en mayor medida a QDA que a LDA. Sin embargo, pese a que tiene un accuracy menor, el resultado obtenido no deja de ser bueno, ya que en el dataset de entrenamiento clasificó de forma correcta al 98% de los casos y al igual que con LDA, si bien al no cumplir los supuestos, no se puede confiar en los resultados, en la práctiva vemos que el método de clasificación funciona y muy bien.

3- Algoritmo SVM

Aplique el algoritmo SVM al conjunto de datos. Interprete los resultados.

Realizaremos el análisis sobre los 3 posibles clasificadores vistos en la cursada. - Kernel lineal - Kernel sigmoideo - Kernel radial

Kernel lineal

# Defino modelo SVM
set.seed(907)
task = makeClassifTask(data = df_train, target = "variedad") 
lrn_svm_1 = makeLearner("classif.svm", predict.type = "prob", par.vals = list( kernel = "linear", cost=2)) 
mod_svm_1 = mlr::train(lrn_svm_1, task)

# Predicción TEST
pred_svm_1 <- predict(mod_svm_1, newdata = df_test)
acc_svm_1 <- round(measureACC(as.data.frame(pred_svm_1)$truth, as.data.frame(pred_svm_1)$response), 3)
AUC_svm_1 <- round(measureAUC(as.data.frame(pred_svm_1)$prob.1,as.data.frame(pred_svm_1)$truth,'2','1'),3)

# Predicción TRAIN (naive)
pred_svm_1_tr = predict(mod_svm_1, newdata = df_train)
acc_svm_1_tr <- round(measureACC(as.data.frame(pred_svm_1_tr)$truth, as.data.frame(pred_svm_1_tr)$response),3)
AUC_svm1_tr <- round(measureAUC(as.data.frame(pred_svm_1_tr)$prob.1,as.data.frame(pred_svm_1_tr)$truth, '2','1'),3)

# ················ Métricas del modelo de SVM ················
Métrica <- c('valor','datos')
Accuracy <- c(acc_svm_1,'prueba')
Accuracy_tr <- c(acc_svm_1_tr,'entrenamiento')
AUC_ROC <- c(AUC_svm_1,'prueba')
AUC_ROC_tr <- c(AUC_svm1_tr,'entrenamiento')

# Imprimo resultados
kable(rbind(Métrica, Accuracy, Accuracy_tr, AUC_ROC, AUC_ROC_tr))
Métrica valor datos
Accuracy 1 prueba
Accuracy_tr 0.993 entrenamiento
AUC_ROC 1 prueba
AUC_ROC_tr 0.998 entrenamiento 
# Gráfico de los resultados
df_svm = generateThreshVsPerfData(list(svm_te = pred_svm_1, svm_tr = pred_svm_1_tr), 
                                  measures = list(fpr, tpr, mmce))

plotROCCurves(df_svm) + theme +
        labs(title='Curva ROC del modelo de Máquinas de soporte vectorial SVM kernel lineal', 
             x='Tasa de falsos positivos (FPR)', y='Tasa de positivos verdaderos (TPR)',
             color='Conjunto de\n evaluación') +
        scale_color_manual(values = c("red", "darkred"), labels=c('prueba','entrenamiento')) +
        geom_label(label="AUC= 1", x=0.35, y=0.75, label.size = 0.3, size=4,
                   color = "red",fill="white") + 
        geom_label(label="AUC= 0.998", x=0.07, y=0.97, label.size = 0.3, size=4,
                   color = "darkred",fill="white")

Kernel sigmoideo

# Defino modelo SVM
set.seed(907)

task_2 = makeClassifTask(data = df_train, target = "variedad") 
lrn_svm_2 = makeLearner("classif.svm", predict.type = "prob", par.vals = list( kernel = "sigmoid", cost=2)) 
mod_svm_2 = mlr::train(lrn_svm_2, task)
# Predicción TEST
pred_svm_2= predict(mod_svm_2, newdata = df_test)
acc_svm_2 <- round(measureACC(as.data.frame(pred_svm_2)$truth, as.data.frame(pred_svm_2)$response),3)
AUC_svm_2 <- round(measureAUC(as.data.frame(pred_svm_2)$prob.1, as.data.frame(pred_svm_2)$truth,'2','1'),3)

# Predicción TRAIN (naive)
pred_svm_2_tr = predict(mod_svm_2, newdata = df_train) 
acc_svm_2_tr <- round(measureACC(as.data.frame(pred_svm_2_tr)$truth, as.data.frame(pred_svm_2)$response),3)
AUC_svm_2_tr <- round(measureAUC(as.data.frame(pred_svm_2_tr)$prob.1, as.data.frame(pred_svm_2_tr)$truth,'2','1'),3)

# ················ Métricas del modelo de SVM ················
Métrica <- c('valor','datos')
Accuracy_2 <- c(acc_svm_2, 'prueba')
Accuracy_2_tr <- c(acc_svm_2_tr, 'entrenamiento')
AUC_ROC_2 <- c(AUC_svm_2, 'prueba')
AUC_ROC_2_tr <- c(AUC_svm_2_tr, 'entrenamiento')

# Imprimo resultados de métricas de performance
kable(rbind(Métrica, Accuracy_2, Accuracy_2_tr, AUC_ROC_2, AUC_ROC_2_tr))
Métrica valor datos
Accuracy_2 0.975 prueba
Accuracy_2_tr 0.553 entrenamiento
AUC_ROC_2 0.995 prueba
AUC_ROC_2_tr 0.988 entrenamiento 
# Gráfico de los resultados
df_svm_2 = generateThreshVsPerfData(list(svm_te = pred_svm_2, svm_tr = pred_svm_2_tr), 
                                  measures = list(fpr, tpr, mmce))

plotROCCurves(df_svm_2) + theme +
        labs(title='Curva ROC del modelo de Máquinas de soporte vectorial SVM kernel sigmoideo', 
             x='Tasa de falsos positivos (FPR)', y='Tasa de positivos verdaderos (TPR)',
             color='Conjunto de\n evaluación') +
        scale_color_manual(values = c("red", "darkred"), labels=c('prueba','entrenamiento')) +
        geom_label(label="AUC= 0.995", x=0.35, y=0.75, label.size = 0.3, size=4,
                   color = "red",fill="white") + 
        geom_label(label="AUC= 0.988", x=0.07, y=0.97, label.size = 0.3, size=4,
                   color = "darkred",fill="white")

Kernel radial

set.seed(907)

task = makeClassifTask(data = df_train, target = "variedad") 
lrn_svm_3 = makeLearner("classif.svm", predict.type = "prob", par.vals = list( kernel = "radial", cost=2)) 
mod_svm_3 = mlr::train(lrn_svm_3, task)

# Predicción TEST
pred_svm_3 = predict(mod_svm_3, newdata = df_test)
acc_svm_3 <- round(measureACC(as.data.frame(pred_svm_3)$truth, as.data.frame(pred_svm_3)$response),3)
AUC_svm_3 <- round(measureAUC(as.data.frame(pred_svm_3)$prob.1, as.data.frame(pred_svm_3)$truth, '2', '1'), 3)

# Predicción TRAIN (naive)
pred_svm_3_tr = predict(mod_svm_3, newdata = df_train) # por si quiero ver naive sobre training
acc_svm_3_tr <- round(measureACC(as.data.frame(pred_svm_3_tr)$truth, as.data.frame(pred_svm_3_tr)$response),3)
AUC_svm_3_tr <- round(measureAUC(as.data.frame(pred_svm_3_tr)$prob.1, as.data.frame(pred_svm_3_tr)$truth, '2', '1'), 3)

# ················ Métricas del modelo de SVM ················
Métrica <- c('valor','datos')
Accuracy_3 <- c(acc_svm_3, 'prueba')
Accuracy_3_tr <- c(acc_svm_3_tr, 'entrenamiento')
AUC_ROC_3 <- c(AUC_svm_3, 'prueba')
AUC_ROC_3_tr <- c(AUC_svm_3_tr, 'entrenamiento')

# Imprimo resultados de métricas de performance
kable(rbind(Métrica, Accuracy_3, Accuracy_3_tr, AUC_ROC_3, AUC_ROC_3_tr))
Métrica valor datos
Accuracy_3 1 prueba
Accuracy_3_tr 0.996 entrenamiento
AUC_ROC_3 1 prueba
AUC_ROC_3_tr 0.999 entrenamiento 
df_svm_3 = generateThreshVsPerfData(list(svm_te = pred_svm_3, svm_tr = pred_svm_3_tr), 
                                  measures = list(fpr, tpr, mmce))

plotROCCurves(df_svm_3) + theme +
        labs(title='Curva ROC del modelo de Máquinas de soporte vectorial SVM kernel radial', 
             x='Tasa de falsos positivos (FPR)', y='Tasa de positivos verdaderos (TPR)',
             color='Conjunto de\n evaluación') +
        scale_color_manual(values = c("red", "darkred"), labels=c('prueba','entrenamiento')) +
        geom_label(label="AUC= 1", x=0.35, y=0.75, label.size = 0.3, size=4,
                   color = "red",fill="white") + 
        geom_label(label="AUC= 0.999", x=0.07, y=0.97, label.size = 0.3, size=4,
                   color = "darkred",fill="white")

Nota: Intenté mostrar los resultados en el gráfico de componentes principales, junto con la clasificación que habían obtenido, pero obtengo un error de compatibilidad con ggbiplot y data de tipo prcomp.

Conclusiones

En base al experimento planteado, se observa que en este caso, el kernel lineal y radial se comportan de la misma forma con un accuracy del 100% y el sigmoideo presenta un rendimiento menor, aunque muy bueno, de 97.5%.

SVM se comporta con una performance superior a método de análisis discriminante, teniendo una tasa de aciertos casi perfecta. Esto me plantea la duda de si los resultados están overfitteados de alguna forma o si los outliers que supongo afectaron al LDA/QDA en SVM están provocando que esos casos que antes molestaban ahora estén generando que los modelos se adaopten a esos casos y en otro dataset tengan un rendimiento inferior o haya que reentrenarlo. Sin embargo, aun disminuyendo algunos puntos, tener una tasa mayor a 90% es excelente.

Resultado final de los 3 modelos:
ACC_values <- rbind(acc_svm_1, acc_svm_2, acc_svm_3)
AUC_values <- rbind(AUC_svm_1, AUC_svm_2, AUC_svm_3)
svm_result_df <- as.data.frame(AUC_values)
svm_result_df$ACC <- ACC_values
svm_result_df$Modelo <- c('Lineal', 'Sigmoideo', 'Radial')
colnames(svm_result_df) <- c('Area debajo de la curva (AUC)', 'Accuracy', 'Modelo')
row.names(svm_result_df) <- NULL
result <- svm_result_df%>%dplyr::select(3,1,2)

kable(result)
Modelo Area debajo de la curva (AUC) Accuracy
Lineal 1.000 1.000
Sigmoideo 0.995 0.975
Radial 1.000 1.000

4- Clasificación jerárquica

Elija un método de Clasificación jerárquico y aplíquelo a los datos. Interprete los resultados.

Lo primero que haremos será reducir la cantidad de individuos en nuestra muestra, ya que este método es muy costoso computacionalmente y los resultados pierden sentido cuando se grafican muchos individuos. Se tomó una muestra del 10% por lo que de 2000 registros pasamos a 200.

set.seed(907)

hierarchical_df = df_DatosTP1 %>%
  group_by(variedad) %>%
  sample_n(100, replace=FALSE) %>%
  mutate_at('variedad', as.factor)

hierarchical_numeric_df = hierarchical_df %>% dplyr::select(where(is.numeric))
hierarchical_numeric_df = hierarchical_numeric_df[, ! names(hierarchical_numeric_df) %in% c("variedad"), drop = F]

# Escalo los datos y hago PCA
datos.pc2 = prcomp(hierarchical_numeric_df, scale = TRUE)

kable(table(hierarchical_df$variedad))
Var1 Freq
1 100
2 100

Matriz de distancias Euclidea

# Matriz de distancias euclídeas 
euc_dist_mat <- dist(x = hierarchical_numeric_df, method = "euclidean") 

# Dendrogramas (según el tipo de segmentación jerárquica aplicada)  
hc_euc_complete <- hclust(d = euc_dist_mat, method = "complete") 
hc_euc_average  <- hclust(d = euc_dist_mat, method = "average")
hc_euc_single   <- hclust(d = euc_dist_mat, method = "single")
hc_euc_ward     <- hclust(d = euc_dist_mat, method = "ward.D2")

# calculo del coeficiente de correlacion cofenetico
euc_completo <- round(cor(x = euc_dist_mat, cophenetic(hc_euc_complete)),3)
euc_promedio <- round(cor(x = euc_dist_mat, cophenetic(hc_euc_average)),3)
euc_simple <- round(cor(x = euc_dist_mat, cophenetic(hc_euc_single)),3)
euc_ward <- round(cor(x = euc_dist_mat, cophenetic(hc_euc_ward)),3)
euc_valores_coef <- cbind(euc_completo, euc_promedio, euc_simple, euc_ward)

# Imprimo valores de coeficiente cofenético
kable(euc_valores_coef)
euc_completo euc_promedio euc_simple euc_ward
0.752 0.778 0.643 0.755

Matriz de distancias Manhattan

# Matriz de distancias euclídeas 
man_dist_mat <- dist(x = hierarchical_numeric_df, method = "manhattan") 

# Dendrogramas (según el tipo de segmentación jerárquica aplicada)  
hc_man_complete <- hclust(d = man_dist_mat, method = "complete") 
hc_man_average  <- hclust(d = man_dist_mat, method = "average")
hc_man_single   <- hclust(d = man_dist_mat, method = "single")
hc_man_ward     <- hclust(d = man_dist_mat, method = "ward.D2")

# calculo del coeficiente de correlacion cofenetico
man_completo <- round(cor(x = man_dist_mat, cophenetic(hc_man_complete)),3)
man_promedio <- round(cor(x = man_dist_mat, cophenetic(hc_man_average)),3)
man_simple <- round(cor(x = man_dist_mat, cophenetic(hc_man_single)),3)
man_ward <- round(cor(x = man_dist_mat, cophenetic(hc_man_ward)),3)
man_valores_coef <- cbind(man_completo, man_promedio, man_simple, man_ward)

# Imprimo valores de coeficiente cofenético
kable(man_valores_coef)
man_completo man_promedio man_simple man_ward
0.737 0.734 0.651 0.699

Observando los resultados de los coeficientes cofenéticos de las distancias euclidias y manhattan, vemos que el mayor valor está dado por la distancia euclidia para el método promedio, por lo que utilizaremos estos valores para realizar el dendograma, junto a un K = 2 que es la cantidad de categorías en la variable target variedad

cantidad_clusters = 2
jer_average <- cutree(hc_euc_average, k = cantidad_clusters)

# Agrego cluster a dataframe
hierarchical_df$jer_average = jer_average
kable(table(hierarchical_df$jer_average))
Var1 Freq
1 81
2 119

Dendrograma jerárquico

pch=c('royalblue2','#ff7474ff') 
cols_a=alpha(pch[hierarchical_df$variedad[order.dendrogram(as.dendrogram(hc_euc_average))]],0.7)
dend_average <- color_branches(as.dendrogram(hc_euc_average), k = 2)
dend_average <- set(dend_average, "labels_cex", 0.1)
grafico2 <- dend_average %>% set("leaves_pch",19) %>%  
        set("leaves_cex", .8) %>%  set("leaves_col", cols_a) %>% 
        plot(main = "Dendrograma jerárquico",  ylab='Distancia',cex.lab=1, cex.axis=.6)+
        mtext(side = 3, line = 0, at = 75, adj = 0, 'Distancia Promedio')+
        mtext(side = 1, line = 0, at = 120, adj = 1, 'Individuos')
legend(180,100, title='Variedad', 
     legend = c("tinto" , "blanco"), 
     col = c('royalblue2','#ff7474ff') , 
     pch = c(19,19), bty = "n",  pt.cex = 1.5, cex = 0.8 , 
     text.col = "black", horiz = FALSE, inset = c(0, 0.1))

# ·····················································
promedio_cluster1 <- hierarchical_df %>% filter (jer_average == '1')
cluster1 <- table(promedio_cluster1$variedad)
promedio_cluster.1 <- round(prop.table(cluster1)*100,2)
# ·····················································
promedio_cluster2 <- hierarchical_df %>% filter (jer_average == '2')
cluster2 <- table(promedio_cluster2$variedad)
promedio_cluster.2 <- round(prop.table(cluster2)*100,2)

kable(cbind(rbind(cluster1,cluster2),rbind(promedio_cluster.1,promedio_cluster.2)))
1 2 1 2
cluster1 79 2 97.53 2.47
cluster2 21 98 17.65 82.35

Conclusiones

Para aplicar el método jerárquico y poder visualizar los resultados se tuvo que reducir la muestra original de 2000 individuos a 200, ya que al utilizar más individuos el tiempo y costo computacional se eleva considerablemente, al tener que evaluar todos los individuos realizando un producto cartesiano y mantener en memoria todas esas distancias. Además de eso, la visualización en el dendograma se torma muy complicada de entender por la cantidad de individuos interactuando y generando relaciones de distancia.

De los resultados obtenidos, para este subconjunto, se determinó que la mejor distancia es la euclídia, aplicando el método promedio, lo cual generó un dendograma balanceado.

En cuanto a la clasificación, se obtuvo un mejor resultado en la variedad 1, de un 97%, en cambio en la variedad 2, este porcentaje se redujo a tan solo 82%. Puede ser que en la reducción del dataset se haya elegido algún valor atípico o que se enmascaraba en el conjunto mayor, sin embargo, los resultados son muy buenos.

5- K-means

Aplique a los datos el método de clasificación no jerárquico K-means. Interprete los resultados.

Elección del número de clusters

En este caso sabemos que la cantidad de grupos que necesitamos son 2, de acuerdo a las variedades de vino, pero haciedo otro tipo de análisis se podrían llegar a encontrar clusters que representen otro tipo de relación, podrían ser sub-variedades dentro de cada categoría, malbec, syrak, torrontes, etc.

Haremos el análisis para determinar la cantidad de grupos, pero luego se realizará el tratamiento con un k = 2.

datos_para_cluster = numeric_df
#analisis de la cantidad de clusters. Este primer bloque es solo para definir funciones.
#se define una funcion para calcular metricas que orientan sobre el numero de clusters a elegir para el problema.
metrica_kmeans = function(datA_esc, kmax) {
  sil = array()
  sse = array()
  datA_dist= dist(datA_esc, method = "euclidean", diag = FALSE, upper = FALSE, p = 2)
  
  for (i in 2:kmax) { 
    CL  = kmeans(datA_esc,centers=i,nstart=50,iter.max = kmax)
    sse[i]  = CL$tot.withinss 
    CL_sil = cluster::silhouette(CL$cluster, datA_dist)
    sil[i]  = summary(CL_sil)$avg.width
  }
  
  return(data.frame(sse,sil))
}

#en este bloque se estudia cuantos clusters convendría generar segun indicadores tipicos -> por ejemplo el "Silhouette"
kmax = 10

m1   = metrica_kmeans(scale(datos_para_cluster), kmax)  #tipica con estimadores de la normal
m1 <- m1[complete.cases(m1),]
m1$kcluster <- seq(2,kmax,1)
m1 <- m1%>%dplyr::select(3,1,2)
m1_sse <- m1%>%dplyr::select(-3)%>%mutate(metric='SSE')
colnames(m1_sse) <- c('kcluster','value','metric')
m1_sil <- m1%>%dplyr::select(-2)%>%mutate(metric='SIL')
colnames(m1_sil) <- c('kcluster','value','metric')
m1 <- rbind(m1_sse,m1_sil)
# Grafico de métricas SIL y SSE
ggplot(m1, aes(kcluster, value, linetype=metric)) + geom_line(col='red') + 
        facet_wrap(~metric, ncol=1, scales='free')+theme+geom_point(col='red', size=2, fill='pink', shape=21)+
        labs(title='Determinación de número de clusters', 
             x='k Número de clusters', y='Valor', linetype='Métrica')+
        scale_x_continuous(breaks = seq(1, kmax, by = 1))+
        scale_linetype_manual(values=c(1,2))

Según podemos apreciar, 4 o 5 sería el número indicado para identificar los agrupamientos que se dan dantro del dataset de entrenamiento. Sin embargo, por la naturaleza del problema utilizaremos un k = 2 para clasificar a los individuos en variedad tinto o blanco.

Evolución según número de clusters

A continuación se presentan los resultados de aplicar k-means con K entre 2 y 5, que son los valores que detectamos pueden obtener valores significativos.

Observando los gráficos vemos que el mejor agrupamiento es K = 2 donde hay un menor solapamiento en los subconjuntos generados. A partir de K = 3 vemos que los subconjuntos se solapan mucho, principalmente del lado positivo de la PC1. Posiblemente se puedan descubrir subconjuntos de poblaciones, pero la cantidad de errores tipo 1 y 2 crecerá considerablemente.

set.seed(907)

cantidad_clusters = 2
CL = kmeans(scale(datos_para_cluster), cantidad_clusters)
stratified_df$kmeans_2 = as.factor(CL$cluster)

cantidad_clusters = 3
CL = kmeans(scale(datos_para_cluster), cantidad_clusters)
stratified_df$kmeans_3 = as.factor(CL$cluster)

cantidad_clusters = 4
CL = kmeans(scale(datos_para_cluster), cantidad_clusters)
stratified_df$kmeans_4 = as.factor(CL$cluster)

cantidad_clusters = 5
CL = kmeans(scale(datos_para_cluster), cantidad_clusters)
stratified_df$kmeans_5 = as.factor(CL$cluster)

original_plot = autoplot(pca,
         data = stratified_df,
         colour = 'variedad',
         loadings = TRUE,
         loadings.colour = 'black',
         loadings.label = TRUE,
         loadings.label.size = 4,
         loadings.label.color = 'black') +
  stat_ellipse(geom = "polygon",
               aes(color = variedad,
               linetype = variedad,
               fill = variedad,
               title = "Original"), 
               alpha = 0.25) + 
  ggtitle("Original")

k_2_plot = autoplot(pca,
         data = stratified_df,
         colour = 'kmeans_2',
         loadings = TRUE,
         loadings.colour = 'black',
         loadings.label = TRUE,
         loadings.label.size = 4,
         loadings.label.color = 'black') +
  stat_ellipse(geom = "polygon",
               aes(color = kmeans_2,
               linetype = kmeans_2,
               fill = kmeans_2), 
               alpha = 0.25) + 
  ggtitle("K = 2")

k_3_plot = autoplot(pca,
         data = stratified_df,
         colour = 'kmeans_3',
         loadings = TRUE,
         loadings.colour = 'black',
         loadings.label = TRUE,
         loadings.label.size = 4,
         loadings.label.color = 'black') +
  stat_ellipse(geom = "polygon",
               aes(color = kmeans_3,
               linetype = kmeans_3,
               fill = kmeans_3), 
               alpha = 0.25) + 
  ggtitle("K = 3")

k_4_plot = autoplot(pca,
         data = stratified_df,
         colour = 'kmeans_4',
         loadings = TRUE,
         loadings.colour = 'black',
         loadings.label = TRUE,
         loadings.label.size = 4,
         loadings.label.color = 'black') + 
  stat_ellipse(geom = "polygon",
               aes(color = kmeans_4,
               linetype = kmeans_4,
               fill = kmeans_4,
               title = "K=4"), 
               alpha = 0.25) + 
  ggtitle("K = 4")

k_5_plot = autoplot(pca, 
         data = stratified_df, 
         colour = 'kmeans_5',
         loadings = TRUE, 
         loadings.colour = 'black',
         loadings.label = TRUE, 
         loadings.label.size = 4,
         loadings.label.color = 'black') + 
  stat_ellipse(geom = "polygon",
               aes(color = kmeans_5,
               linetype = kmeans_5,
               fill = kmeans_5), 
               alpha = 0.25) + 
  ggtitle("K = 5")

original_plot

k_2_plot

k_3_plot

k_4_plot

k_5_plot

Comparación de resultados contra el dataset original

De los gráficos anteriores y del análisis de la clasificación realizada por k-means con K = 2, vemos que el porcentaje de aciertos es superior al 98% en ambas variedades, lo cual lo posiciona por debajo de LDA y SVM, pero son valores muy altos.

Al ver los gráficos vemos que hay varios puntos fuera de las elipses de los grupos, lo cual nos permite entender que el modelo que estamos construyendo en este caso está afectados por estos valores atípicos que estan separados del centro de cada grupo y que hacen que la dispersión afecte la generación de los grupos según el origen inicial que haya determinado k-means como centros iniciales.

Comparandolo con SVM el tiempo de calculo y renderizado de los resultados es menor.

# cuántos pacientes de cada diagnóstico están en cada cluster:
vinos_cluster1 <- stratified_df %>% filter (kmeans_2 == '1')
cluster1 <- table(vinos_cluster1$variedad)
porcentaje_cluster_1 <- round(prop.table(cluster1)*100,2)

vinos_cluster2 <- stratified_df %>% filter (kmeans_2 == '2')
cluster2 <- table(vinos_cluster2$variedad)
porcentaje_cluster_2 <- round(prop.table(cluster2)*100,2)
# ·····················································
# Imprimo resultados
kable(cbind(rbind(cluster1, cluster2), rbind(porcentaje_cluster_1, porcentaje_cluster_2)))
1 2 1 2
cluster1 984 13 98.7 1.3
cluster2 16 987 1.6 98.4

6- Conclusiones finales

Me gustaría dividir las conclusiones en 3 partes. Primero hacer referencia al análisis de componentes principales, luego a la clasificación y predicción de los variedades de vinos y por último a un breve resumen personal de la experiencia al realizar el presente trabajo.

Para el análisis de las componentes principales, se realizó una breve exploración de los datos, siendo que en el TP anterior se profundizó en el análisis univariado, ya se contaba con una ligera comprensión de los datos con los que se está trabajando, por lo que el enfoque estuvo dado en comprender si existe alguna correlación entre las variables y comprender la varianza que existe, para luego poder analizar los resultados obtenidos por el método de componentes principales. Una vez aplicado el método y luego de evaluar los criterios, se decidió que utilizar 4 componentes permite reducir la dimensionalidad del problema y mantener un varianza explicada suficiente para analizar y visualizar los procedimientos que se quiera aplicar, como sucedió con el caso de K-means, donde se pudo evidenciar el agrupamiento en las dimensiones reducidas, que hubise sido imposible de evaluar con las 12 variables que componen el dataset.

Con los loadings y scores obtenidos intenté darle nombre a las componentes principales, pero al no tener contexto sobre el dominio del problema no logré encontrarles significado, pero si se logra ver cuales son las variables que más influyen en cada PC y surgen algunas ideas que sería necesario validarlas con algún experto. Por ejemplo, en la PC1 se observan como principales contribuidores a la acidez, los anhídrido.sulfurosos y azúcar, por lo que se podría pensar que esta componente habla de las tonalidades o sabores que tiene cada vino, donde la acidez está en correspondencia a los vinos tintos y la dulzura a los vinos blancos.

En relación al resto del TP que está vinculado a los métodos de clasificación, lo primero con lo que me topé fue con el incumplimiento de los supuestos para poder tener confianza en los resultados obtenidos, pero en la práctica se observó que la clasificación se realizó con un grado de accuracy mayor al 95%, lo cual es un valor muy alto considerando que no se cumple con los supuestos, lo cual me lleva a pensar que puede ser la cantidad de datos lo que permita que los resultados sean buenos o que las muestras tomadas ya han sido tratadas o mejoradas de alguna forma para contribuir a los experimentos. Sea el caso se sea, se pudieron ejecutar todos los experimentos y observar y comprobar los temas teóricos vistos durante la cursada.

Para el análisis discriminante y SVM se generaron dataset de entrenamiento y test con una proporción de 90/10 y como se comentó previamente, no se pudieron validar los supuestos de Normalidad y Homocedasticidad, pero si se pudo verificar que las medias de los conjuntos no sean iguales, lo que impediría realizar cualquier método de clasificación al no poder separar en grupos a los individuos. En cuanto a LDA y QDA, se observó que el accuracy de QDA es menor, lo cual puede ser por la presencia de outliers, donde QDA es más sensible o puede ser que la falta de normalidad esté afectando en mayor medida a QDA que a LDA. Algo que no se realizó por falta de tiempo, fue un análisis detallada de este supuesto de outliers o datos atípicos para determinar si efectivamente esa es la causa, pero se deja planteada la hipotesis para un trabajo futuro.

En el análisis de SVM se observó una tasa de aciertos casi perfecta. Lo cual es sospechoso, pero no logré encontrar algún indicio de distorsión en los datos o problema en la ejecución que esté generando alguna omisión en validaciones u overfitting, por lo que se asume que los datos son correctos y se presentaron los resultados obtenidos.

Para aplicar el método jerárquico y poder visualizar los resultados se tuvo que reducir la muestra original a un 10%, ya que al utilizar una gran cantidad de individuos el tiempo y costo computacional se eleva considerablemente, además de complicar la lectura del dendograma. Se determinó que, para este dataset, la mejor distancia para aplicar en el experimento es la distancia euclídia, aplicada en conjunto con el método de distancia promedio entre los individuos. En cuanto a la clasificación, se obtuvo un mejor resultado en la variedad 1, de un 97%, en cambio en la variedad 2, este porcentaje se redujo a tan solo 82%. Puede ser que en la reducción del dataset se haya elegido algún valor atípico o que se enmascaraba en el conjunto mayor, sin embargo, los resultados son muy buenos.

Por último, se realizó el análsis con k-means, para lo cual en primer instancia se analizó la cantidad de cluster “óptimo” y se aplicó el método con 2, 3, 4 y 5 clusters y se graficaron los resultados sobre las PC1 y PC2 para comparar la clasificación son los datos originales. Se observó que para k = 2, la clasificación es casi igual a los valores originales, lo cual era esperable, pero al utilizar una mayor cantidad de grupos, estos se empiezan a solapar y si bien, los nuevos grupos ya no representan a las variedades originales (tinto y blanco), sino que están representando otro tipo de variedad que no conocemos pero que son un subconjunto de estos, ya que los nuevos grupos están subscriptos al dominio original, no se observa que uno de estos grupos comparta individuos de las categoria originales. También se detectó al ver los gráficos que hay varios puntos fuera de las elipses de los grupos, lo cual nos permite entender que el modelo que estamos construyendo está siendo afectados por estos valores atípicos que estan separados del centro de cada grupo y que hacen que la dispersión afecte la generación de los grupos según el origen inicial que haya determinado k-means como centros iniciales.

En cuanto al resumen personal que realizo del TP, me llevo los siguientes temas. Al utilizar datos reales, como los que asumimos para este trabajo, es normal que no se cumplan los supuestos y se termine utilizando los métodos igualmente con cierto grado de desconfianza, ya que clasifican correctamente, pero no cuentan con el sustento formal que brindan los supuestos de normalidad y homocedasticidad. Esto en general se termina solucionando con la aplicación de algún método robusto o no paramétrico. Agradezco mucho la ayuda brindada por los ejemplos vistos en clase y la posibilidad de poder ejecutar rápidamente cada uno de los métodos y poder realizar el análisis de los resultados, ya que me encontré con varios problemas durante la ejecución y poder contar con esos ejemplos de base me permitieron encontrar la solución o los paquetes y documentación que consultar. Un problema con el que me topé y no pude solucionar, fue graficar los resultados de las predicciones de SVM junto a las componentes principales, por un problema de compatibilidad con la función ggbiplot y data de tipo prcomp, lo cual pude mitigar en k-means con autoplot.